home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 2
/
Atari Mega Archive CD - Volume 2.iso
/
8bit
/
cislib_b
/
pcopy.atr
< prev
next >
Wrap
Text File
|
1995-04-22
|
4KB
|
92 lines
10 GOTO 375
15 GRAPHICS K0:? "POLYCOPY - ATARI v 2.0"
20 ? "Space for ";INT(BUFF/125);" sectors":? :IP=-K1
25 GOSUB 250:IF IP=DSN THEN 40
30 IF IP<DSN THEN GOSUB 355:IF Z=YES THEN 25
35 IF IP<K1 THEN 235
40 MAX=IP-K1:? "Type 'Y' if O.K. ";:GOSUB 335:? :IF Z<>YES THEN 235
45 IP=K0:OP=K0:SPLIT=HI:APND=HI:GOTO 55
50 ? :GOSUB 325
55 ADDR=ADR(Y$):ROOM=BUFF
60 IF IP>MAX THEN IP=IP-K1:GOSUB 145:GOTO 240
65 Y=IP:GOSUB 230:TRAP 80:OPEN #K1,K4,K0,DSN$:TRAP TOFF
70 IF SPLIT<>IP THEN ? "LOADING ";DSN$;:GOTO 100
75 TRAP 80:POINT #K1,SEC,BYTE:TRAP TOFF:APND=IP:? "Contin'g ";DSN$;:GOTO 100
80 TRAP TOFF:Z=PEEK(195):CLOSE #K1:IF Z<>170 THEN 110
85 ? :? DSN$;" not found,":? "Want to try another disk?";
90 GOSUB 350:? :IF Z=YES THEN ? "Insert new disk";:GOSUB 330:GOTO 65
95 X(IP,K0)=K0:IP=IP+K1:GOTO 60
100 X(IP,K0)=ADDR
105 SIZE=USR(CIO,K1,7,ADDR,ROOM):Z=PEEK(851):IF Z<128 OR Z=136 THEN 115
110 CLOSE #K1:? :GOSUB 370:GOTO 95
115 ? " size = ";SIZE;:X(IP,K1)=SIZE:IF Z=136 THEN 125
120 ? "/";:NOTE #K1,SEC,BYTE:SPLIT=IP
125 ? :CLOSE #K1
130 ADDR=ADDR+SIZE:ROOM=ROOM-SIZE:IF ROOM>K0 THEN IP=IP+K1:GOTO 60
135 GOSUB 145:IF SPLIT<>IP THEN IP=IP+K1:IF IP>MAX THEN 60
140 GOTO 50
145 IF ROOM=BUFF THEN RETURN
150 ? :? "Insert destination disk";:GOSUB 330
155 ADDR=X(OP,K0):SIZE=X(OP,K1):IF ADDR=K0 THEN 220
160 Y=OP:GOSUB 230:Z=8:IF APND=OP THEN Z=Z+K1
165 TRAP 185:OPEN #K2,Z,K0,DSN$:TRAP TOFF:IF APND=OP THEN ? "Append'g ";:GOTO 175
170 ? "Writing ";
175 ? DSN$;" size = ";SIZE
180 Z=USR(CIO,K2,11,ADDR,SIZE)
185 Z=PEEK(867)
190 TRAP 190:CLOSE #K2:TRAP TOFF:IF Z<128 THEN 220
195 IF Z<>162 THEN GOSUB 370:GOTO 220
200 ? "Disk full, try another?";:GOSUB 335:IF Z<>YES THEN 235
205 TRAP 210:XIO 33,#K2,K0,K0,DSN$
210 TRAP TOFF:IF APND<>OP THEN ? "Insert new disk";:GOSUB 330:GOTO 155
215 IP=OP:SPLIT=HI:APND=HI:POP :GOTO 50
220 IF OP<IP THEN OP=OP+K1:GOTO 155
225 RETURN
230 DSN$="D:":DSN$(K3)=X$(Y*K12+K1,Y*K12+K12):GOTO 360
235 ? :? " USER ABORTED! "
240 GOSUB 355:IF Z=YES THEN 15
245 CLR :END
250 GOSUB 325:CLOSE #K3:OPEN #K3,6,K0,"D:*.*":IF IP<K0 THEN IP=K0:X$="":? " Copy, Quit, other to skip "
255 INPUT #K3,Y$:IF LEN(Y$)<17 THEN 320
260 DSN$="":FOR Z=K3 TO 13:IF Z=11 THEN DSN$(LEN(DSN$)+K1)="."
265 IF Y$(Z,Z)=" " THEN 275
270 DSN$(LEN(DSN$)+K1)=Y$(Z,Z)
275 NEXT Z:IF DSN$="DOS.SYS" THEN 255
280 IF LEN(DSN$)<K12 THEN DSN$(LEN(DSN$)+K1,K12)=" "
285 SEC=K0:TRAP 290:SEC=VAL(Y$(15,17))
290 TRAP TOFF:? IP+K1;:POKE COL,5:? DSN$;:POKE COL,22:? SEC;:POKE COL,28:? "?";:GOSUB 340
295 IF Z=67 THEN ? CHR$(30);"C":GOTO 310
300 ? CHR$(ERASE);:IF Z=81 THEN 320
305 GOTO 255
310 X$(LEN(X$)+K1)=DSN$:IP=IP+K1:IF IP=DSN THEN 320
315 GOTO 255
320 CLOSE #K3:RETURN
325 ? "Insert 'from' disk";
330 ? ", press any key"
335 GOSUB 340:? CHR$(ERASE);:RETURN
340 GET #K4,Z:IF Z=27 THEN POP :GOTO 235
345 RETURN
350 GOSUB 340:? :RETURN
355 ? :? "Any more files?";:GOTO 335
360 Z=PEEK(764):POKE 764,HI-K1:IF Z=28 THEN 235
365 RETURN
370 ? "[";Z;"] I/O ERROR ON ";DSN$:? "...skipping to next file":? :RETURN
375 REM DELETES LINES BELOW THIS POINT
380 GRAPHICS K0:POSITION 13,12:? " PLEASE WAIT "
385 K0=0:K1=1:K2=K1+K1:K3=K2+K1:K4=K3+K1:K12=K4*K3:HI=256:TOFF=40000
390 YES=89:LET ERASE=156:COL=YES-K4:OPEN #K4,K4,K0,"K:"
395 DSN=16:DIM DSN$(16),X$(DSN*K12),X(DSN-K1,K1)
400 CIO=960:FOR Y=K0 TO 42:READ Z:POKE CIO+Y,Z:NEXT Y:POKE 709,PEEK(710)
405 DATA 104,104,104,10,10,10,10,170
410 DATA 104,104,157,66,3,104,157,69
415 DATA 3,104,157,68,3,104,157,73
420 DATA 3,104,157,72,3,32,86,228
425 DATA 189,72,3,133,212,189,73,3
430 DATA 133,213,96
435 MAX=842:APND=35
440 IP=375:OP=450:REM LINE REMOVAL NUMBERS
445 GOTO 460:REM REMOVE THIS LINE TO ALLOW DELETES
450 ? CHR$(125):? :FOR Z=IP TO OP STEP 5:PRINT Z:NEXT Z:? "CONT":POSITION K0,K0:POKE MAX,13
455 STOP
460 POKE MAX,K12:BUFF=FRE(K0)-APND:DIM Y$(BUFF):BUFF=BUFF-K3:GOTO 15